;;; xwl-programming.el --- programming config

;; Copyright (C) 2007 William Xu

;; Author: William Xu <william.xwl@gmail.com>

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA

;;; Code:

;;; C, C++

;; (require 'cc-mode)
;; M-x semanticdb-save-all-db
;; M-x semanticdb-create-system-database
;; M-x bovinate
;; M-x hide-ifdef-mode

;; C-c C-e (expand macros)
;; C-c C-\ (indent beautifully)

(defun xwl-c-mode-common-hook ()
  ;; == general ==
  (if xwl-at-company-p
      (c-set-style "whitesmith")        ; symbian c++
    (c-set-style "k&r"))

  (setq c-cleanup-list
        '(scope-operator
          empty-defun-braces
          defun-close-semi))

  (setq tab-width 4)
  (setq indent-tabs-mode nil)

  ;; Don't enable for lex/yacc files.
  (when (and (buffer-file-name) ; mmm-mode submodes don't have a  valid buffer name.
             (not (string-match "\\.l$\\|\\.y$" (buffer-file-name))))
    (c-toggle-auto-hungry-state 1))

  ;; == submodes ==
  ;; (glasses-mode 1)
  ;; (hs-minor-mode 1)
  ;; (hs-hide-all)
  ;; (xwl-hs-minor-mode-hook)
  ;; (hide-ifdef-mode 1)
  (auto-fill-mode -1)
  (smart-operator-mode 1)
  (abbrev-mode 1)
  (cwarn-mode 1)
  ;;  (which-func-mode 1)
  (when (fboundp 'doxymacs-mode)
    (doxymacs-mode 1)
    (doxymacs-font-lock))
  (c-subword-mode 1)

  (setq hide-ifdef-initially t)

  ;; == keys ==
  (local-unset-key (kbd "("))
  (local-unset-key (kbd "."))
  (local-unset-key (kbd "%"))

  (local-set-key (kbd "C-c m a") 'align)
  (local-set-key (kbd "*") 'c-electric-star)
  (local-set-key (kbd ";") 'c-electric-semi&comma)
  (local-set-key (kbd "ESC TAB") 'semantic-ia-complete-symbol)
  (local-set-key (kbd "<C-home>") 'gdb)
  ;; 'semantic-chart-nonterminal-complexity-token)
  (local-set-key (kbd "<C-prior>") 'expand-member-functions))

(add-hook 'c-mode-common-hook 'xwl-c-mode-common-hook)

(autoload 'expand-member-functions
  "member-functions" "Expand C++ member function declarations" t)


;;; Tags, code browsing

;; imenu, cscope, etags
;; speedbar, semantic, eieio, ecb, xref

;; etags
(defun xwl-etags-on-c (dir)
  "Run `etags' on c files(*.h and *.c) under DIR recursively.
Thus generate a TAGs file."
  (interactive "DEtags on: ")
  (shell-command
   (format "find '%s' -type f -regex '.*\\.h$\\|.*\\.c$' | xargs etags "
           dir)))

(defun xwl-etags-on-c++ (dir)
  "Run `etags' on c++ files(*.h, *.c and *.cpp) under DIR recursively.
Thus generate a TAGs file."
  (interactive "DEtags on(TODO,buggy!): ")
  (shell-command
   (format "find \"%s\" -type f -regex \".*\\.h$\\|.*\\.c$\\|.*\\.cpp$\" | xargs etags "
           dir)))


;;; python

(defun xwl-python-mode-hook ()
  (smart-operator-mode 1)
  ;; (local-unset-key (kbd "."))
  )

(add-hook 'python-mode-hook 'xwl-python-mode-hook)



;; - flymake(syntax checker for codes)

;;;; shell-script/conf mode
;; ------------------------

(defun xwl-sh-mode-hook()
  (defun xwl-sh-run ()
    (interactive)
    (shell-command
     (concat "sh "
	     (xwl-resolve-file-name (buffer-file-name) "f"))))

  ;; (set (make-local-variable 'outline-regexp) "###+ ")
  ;; (outline-minor-mode 1)

  (local-set-key (kbd "<C-down>") 'xwl-sh-run))

(add-hook 'sh-mode-hook 'xwl-sh-mode-hook)

;;TODO, add same to conf mode

;;;; sql
;; -----

(eval-after-load 'mysql
  '(progn
     ;; 运行 sql-mysql 时，这个值没设的话，死活无法正确在 sql 语句中含有中文！
     ;;（单单输出是没问题的）
     (setenv "LC_ALL" "zh_CN.utf-8")

     (define-key sql-interactive-mode-map (kbd "RET")
       (lambda ()
         (interactive)
         (save-excursion
           (move-end-of-line 1)
           (unless (looking-back "\\ *;\\ *" (save-excursion
                                               (beginning-of-line)
                                               (point)))
             (insert ";")))
         (comint-send-input)))

     (add-hook 'sql-mode-hook 'smart-operator-mode-on)
     (add-hook 'sql-interactive-mode-hook 'smart-operator-mode-on)
     ))

(eval-after-load "xwl-private"
  '(progn
     (setq sql-mysql-program "mysql"
           sql-user          "william"
           sql-password      ""         ; pwsql
           sql-database      "foo"
           sql-server        "")))

;;;; debug
;; -------

(setq gdb-many-windows t)
(global-set-key (kbd "<C-end>") 'gdb-restore-windows)

;;;; changlog entry
;; ----------------

(setq add-log-full-name nil
      add-log-mailing-address nil)

;;;; c/c++/java
;; ------------

;; doxymacs
;; TODO
;; (require 'doxymacs)

(require 'lisp-mnt)

;;;; version systems
;; -----------------
(when (= emacs-major-version 22)
  (eval-after-load "vc"
    '(progn
       (defun vc-print-log (&optional focus-rev)
         "List the change log of the current buffer in a window.
If FOCUS-REV is non-nil, leave the point at that revision."
         (interactive)
         (vc-ensure-vc-buffer)
         (let ((file buffer-file-name))
           (or focus-rev (setq focus-rev (vc-workfile-version file)))
           ;; Don't switch to the output buffer before running the command,
           ;; so that any buffer-local settings in the vc-controlled
           ;; buffer can be accessed by the command.
           (condition-case err
               (progn
                 (vc-call print-log file "*vc-change-log*")
                 (set-buffer "*vc-change-log*"))
             (wrong-number-of-arguments
              ;; If this error came from the above call to print-log, try again
              ;; without the optional buffer argument (for backward compatibility).
              ;; Otherwise, resignal.
              (if (or (not (eq (cadr err)
                               (indirect-function
                                (vc-find-backend-function (vc-backend file)
                                                          'print-log))))
                      (not (eq (caddr err) 2)))
                  (signal (car err) (cdr err))
                ;; for backward compatibility
                (vc-call print-log file)
                (set-buffer "*vc*"))))
           (pop-to-buffer (current-buffer))
           (vc-exec-after
            `(let ((inhibit-read-only t))
               (vc-call-backend ',(vc-backend file) 'log-view-mode)
               (goto-char (point-max)) (forward-line -1)
               (while (looking-at "=*\n")
                 (delete-char (- (match-end 0) (match-beginning 0)))
                 (forward-line -1))
               (goto-char (point-min))
               (if (looking-at "[\b\t\n\v\f\r ]+")
                   (delete-char (- (match-end 0) (match-beginning 0))))
               ;; (shrink-window-if-larger-than-buffer)
               ;; move point to the log entry for the current version
               (vc-call-backend ',(vc-backend file)
                                'show-log-entry
                                ',focus-rev)
               (set-buffer-modified-p nil)
               (change-log-mode)
               (less-minor-mode-on)
               (goto-char (point-min)))))))))

(add-hook 'log-view-mode-hook 'less-minor-mode-on)

;;;; skeletons
;; -----------

;;  c
(define-skeleton skeleton-c-mode-main-fun
  "generate main(int argc, char *argv[])"
  > "int main(int argc, char *argv[])\n{\n"
  > _ " "
  > "\n\nreturn 0;"
  > "\n}")

(define-skeleton skeleton-c-mode-main-fun1
  "generate main()"
  > "int main()\n{\n"
  > _ " "
  > "\n\nreturn 0;"
  > "\n}")

(define-skeleton skeleton-c-mode-include
  "Generate include<>."
  > "#include <"
  (ido-completing-read
   "Include File: "
   (apply 'append
          (mapcar (lambda (dir) (directory-files dir))
                  '("/usr/include"
                    "~/include")))) ">\n")

;; c++
(define-skeleton skeleton-c++-mode-main-fun
  "generate int main(int argc, char *argv[])"
  > "int main(int argc, char *argv[])\n{\n"
  > _ " "
  > "\n}")

(define-skeleton skeleton-c++-mode-main-fun1
  "generate int main()"
  > "int main()\n{\n"
  > _ ""
  > "\n}")

(define-skeleton skeleton-c++-mode-include
  "Generate include<>."
  > "#include <"
  (ido-completing-read
   "Include file: "
   (apply 'append
          (mapcar (lambda (dir) (directory-files dir))
                  '("/usr/include"
                    "/usr/include/c++/4.0.0"
                    ;; Qt4 on mac
                    "/sw/lib/qt4-mac/include/QtCore"
                    "/sw/lib/qt4-mac/include/QtGui"
                    "/sw/lib/qt4-mac/include"
                    )))) ">\n")

;; java
(define-skeleton skeleton-jde-mode-main-fun
  "Generate: public static void main(String[] args)"
  > "public static void main(String[] args)\n"
  > "{\n"
  > _ " "
  > "\n        }")

(define-skeleton skeleton-jde-mode-print-fun
  "Generate: System.out.println()"
  > "System.out.println("
  > _ ""
  > ");")

;; hs-minor-mode
;; (require 'hideshow)
;; (defun xwl-hs-minor-mode-hook ()
;;   (define-key hs-minor-mode-map (kbd "C-c @ DEL") 'hs-hide-block)
;;  (define-key hs-minor-mode-map (kbd "C-c @ ESC DEL") 'hs-hide-all))


;;;; highlight special keywords
(setq xwl-keyword-highlight-modes
      '(php-mode java-mode c-mode c++-mode emacs-lisp-mode scheme-mode
	text-mode outline-mode))

(grep-compute-defaults)

(setq grep-command "grep -nH -e "
      grep-find-command
      "find . -type f -print0 | xargs -0 grep -nH ")

(global-set-key (kbd "C-c m g") 'grep)
(global-set-key (kbd "C-c m G") 'grep-find)

(make-face 'font-lock-fixme-face)
(make-face 'font-lock-todo-face)

(modify-face 'font-lock-fixme-face "black" "yellow" nil t nil t nil nil)
(modify-face 'font-lock-todo-face  "black" "yellow" nil t nil nil nil nil)

(defun xwl-highlight-special-keywords ()
  (mapc (lambda (mode)
	  (font-lock-add-keywords
	   mode
	   '(("\\<\\(FIXME\\)" 1 'font-lock-fixme-face t)
	     ("\\<\\(TODO\\)"  1 'font-lock-todo-face  t))))
	xwl-keyword-highlight-modes))


(xwl-highlight-special-keywords)

;;;; lex, yacc
;; -----------

(defun xwl-lex-yacc-mode ()
  "Redefine some operators to enhace readability, when editing lex, or
yacc source files."
  (interactive)

  (defun insert-little-line ()
    (interactive)
    (forward-line 0)
    (insert "\t\t| "))

  (defun insert-semicolon ()
    (interactive)
    (insert "           ")		; ten whitespaces
    (forward-line 0)
    (forward-char 8)
    (insert ": "))

  (local-unset-key (kbd "{"))
  (local-unset-key (kbd ";"))
  (local-set-key (kbd "|") 'insert-little-line)
  (local-set-key (kbd ":") 'insert-semicolon))

;;;; java
;; ------

;; (require 'jde)

;;;; elisp
;; -------

(defun xwl-lisp-mode-hook ()
  ;; (which-func-mode 1)
  (eldoc-mode 1)

  (set (make-local-variable 'outline-regexp) ";;;+ ")
  (outline-minor-mode 1)

  (local-set-key (kbd "<backtab>") 'lisp-complete-symbol)
  (local-set-key (kbd "<S-tab>") 'lisp-complete-symbol)
  (local-set-key (kbd "C-x C-r") 'eval-region)
  (local-set-key (kbd "C-x C-b") 'eval-buffer))

(add-hook 'lisp-mode-hook 'xwl-lisp-mode-hook)
(add-hook 'lisp-interaction-mode-hook 'xwl-lisp-mode-hook)
(add-hook 'emacs-lisp-mode-hook 'xwl-lisp-mode-hook)

;;;; scheme
;; --------

(require 'scheme)
(require 'chicken-scheme-extras)

(setq scheme-program-name "csi")
(defun xwl-scheme-mode-hook ()
  (setq comment-add 1)

  (set (make-local-variable 'outline-regexp) ";;;+ ")
  (outline-minor-mode 1)

  (local-set-key (kbd "C-x C-r") 'scheme-send-region)
  (local-set-key (kbd "C-x C-b") 'xwl-scheme-send-buffer))

(add-hook 'scheme-mode-hook 'xwl-scheme-mode-hook)

(defun xwl-scheme-send-buffer ()
  (interactive)
  (scheme-send-region (point-min) (point-max)))

;; change `|' to normal (default, it's set to \")
(modify-syntax-entry ?\| "_   " scheme-mode-syntax-table)

;; (defun xwl-scheme-print-output ()
;;   "Get last session's output."
;;   (interactive)
;;   (with-current-buffer scheme-buffer
;;     (save-excursion
;;       (goto-char (point-max))
;;       (when (<= (current-column) (length "guile> "))
;;         (search-backward "guile>")
;;         (re-search-backward "guile> \\(\\(.*\n\\)+\\)")
;;         (let ((str (match-string-no-properties 1)))
;;           (message (substring str 0 (1- (length str)))))))))


;; (defadvice scheme-send-last-sexp (after scheme-send-last-sexp-advice)
;;   "Print output in minibuf."
;;   (xwl-scheme-print-output))

;; (ad-activate 'scheme-send-last-sexp)

(autoload 'scheme-smart-complete "scheme-complete" nil t)
(eval-after-load 'scheme
  '(progn
     (define-key scheme-mode-map (kbd "<S-tab>") 'scheme-smart-complete)
     ))

(autoload 'scheme-get-current-symbol-info "scheme-complete" nil t)
(add-hook 'scheme-mode-hook
  (lambda ()
    (make-local-variable 'eldoc-documentation-function)
    (setq eldoc-documentation-function 'scheme-get-current-symbol-info)
    (eldoc-mode)))

;; (setq default-scheme-implementation


;; guile
;; -----

(setq guile-program "guile")

;; guile debugger

;; (defadvice gds-help-symbol (after jump-to-help)
;;   (other-window 1))
;;   (less-minor-mode-on))

;; (ad-activate 'gds-help-symbol)

;; (require 'guile-scheme)
;; (setq initial-major-mode 'scheme-interaction-mode)


;;; haskell

(autoload 'haskell-mode "haskell-mode"
  "Major mode for editing Haskell scripts." t)
(autoload 'literate-haskell-mode "haskell-mode"
  "Major mode for editing literate Haskell scripts." t)

(setq auto-mode-alist
      (append auto-mode-alist
              '(("\\.[hg]s$"  . haskell-mode)
                ("\\.hi$"     . haskell-mode)
                ("\\.l[hg]s$" . literate-haskell-mode))))

(defun xwl-haskell-mode-hook ()
  (turn-on-haskell-decl-scan)
  (turn-on-haskell-doc-mode)
  (turn-on-haskell-indent)
  (turn-on-haskell-simple-indent)

  (glasses-mode 1))

(add-hook 'haskell-mode-hook 'xwl-haskell-mode-hook)


;;; Compilation Mode

(defun xwl-compilation-exit-autoclose (status code msg)
  (if (and (eq status 'exit) (zerop code))
      (progn
        (run-at-time 0.5
                     nil
                     (lambda ()
                       (delete-window
                        (get-buffer-window
                         (get-buffer "*compilation*")))))
        (message "Compilation succeed"))
    (message "Compilation failed"))
  (cons msg code))

(setq compilation-exit-message-function 'xwl-compilation-exit-autoclose)

; (require 'tramp-util)

;; (defun tramp-compile (command)
;;   "Compile on remote host."
;;   (interactive
;;    (if (or compilation-read-command current-prefix-arg)
;;        (list (read-from-minibuffer "Compile command: "
;;                                    compile-command nil nil
;;                                    '(compile-history . 1)))
;;      (list compile-command)))
;;   (setq compile-command command)
;;   (save-some-buffers (not compilation-ask-about-save) nil)
;;   (let ((d default-directory)
;;         (status 0))
;;     (save-excursion
;;       (pop-to-buffer (get-buffer-create "*Compilation*") t)
;;       (erase-buffer)
;;       (setq default-directory d)))
;;   (setq status
;;         (tramp-handle-shell-command command (get-buffer "*Compilation*")))
;;   (pop-to-buffer (get-buffer "*Compilation*"))
;;   (tramp-minor-mode 1)
;;   (compilation-minor-mode 1)
;;   (when compilation-exit-message-function
;;     (funcall compilation-exit-message-function 'exit status nil)))


;;; buffer-action

(autoload 'buffer-action-compile "buffer-action")
(autoload 'buffer-action-run "buffer-action")

(eval-after-load 'buffer-action
  '(progn
     (when (string-match "darwin" (xwl-os-type))
       (setq buffer-action-table
             (append `(("\\.tex$" "xelatex %f" "%n.pdf" "open -a Preview %n.pdf &")
                       ("\\.dot$"
                        ,(concat "dot -Tjpg %f -o %n.jpg "
                                 (let ((fontname "Arial Unicode.ttf"))
                                   (mapconcat
                                    (lambda (i)
                                      (format i fontname))
                                    '("-Nfontname='/Library/Fonts/%s'"
                                      "-Gfontname='/Library/Fonts/%s'"
                                      "-Efontname='/Library/Fonts/%s'")
                                    " ")))
                        "%n.jpg"
                        "open -a Preview %n.jpg &")
                       (c++-mode "g++ -O2 %f -lm -I/sw/include -o %n" "%n" "./%n")
                       )
                     buffer-action-table)))))

(global-set-key (kbd "C-<up>")   'buffer-action-compile)
(global-set-key (kbd "C-<down>") 'buffer-action-run)



;; asm
(require 'asm-mode)
;; (define-key asm-mode-map (kbd ":") '(lambda () (interactive) (smart-insert-operator ":" t)))
;; (define-key asm-mode-map (kbd ",") '(lambda () (interactive) (smart-insert-operator "," t)))
(define-key asm-mode-map (kbd "RET") 'newline)

;; ;; php
;; (defun xwl-php-mode-hook ()
;;   (local-unset-key (kbd "/"))
;;   (local-unset-key (kbd "="))
;;   (local-unset-key (kbd ">"))
;;   (local-unset-key (kbd "<")))

;; (add-hook 'php-mode-user-hook 'xwl-php-mode-hook)

;; (add-hook 'html-mode-hook 'xwl-php-mode-hook)

;; perl

(add-to-list 'auto-mode-alist '("\\.\\([pP][Llm]\\|al\\)\\'" . cperl-mode))
(add-to-list 'interpreter-mode-alist '("perl" . cperl-mode))
(add-to-list 'interpreter-mode-alist '("perl5" . cperl-mode))
(add-to-list 'interpreter-mode-alist '("miniperl" . cperl-mode))

(eval-after-load "cperl-mode"
  '(progn
     (add-hook 'cperl-mode-hook 'smart-operator-mode-on)
     (define-key cperl-mode-map (kbd "C-c <f1> f") 'cperl-perldoc)
     ))


;;; cscope

(condition-case nil
    (progn

(require 'ctypes)
(ctypes-auto-parse-mode 1)

(require 'xcscope)
(global-set-key "\C-css" 'cscope-find-this-symbol)
(global-set-key "\C-csd" 'cscope-find-global-definition)
(global-set-key "\C-csg" 'cscope-find-global-definition)
(global-set-key "\C-csG" 'cscope-find-global-definition-no-prompting)
(global-set-key "\C-csc" 'cscope-find-functions-calling-this-function)
(global-set-key "\C-csC" 'cscope-find-called-functions)
(global-set-key "\C-cst" 'cscope-find-this-text-string)
(global-set-key "\C-cse" 'cscope-find-egrep-pattern)
(global-set-key "\C-csf" 'cscope-find-this-file)
(global-set-key "\C-csi" 'cscope-find-files-including-file)
;; --- (The '---' indicates that this line corresponds to a menu separator.)
(global-set-key "\C-csb" 'cscope-display-buffer)
(global-set-key "\C-csB" 'cscope-display-buffer-toggle)
(global-set-key "\C-csn" 'cscope-next-symbol)
(global-set-key "\C-csN" 'cscope-next-file)
(global-set-key "\C-csp" 'cscope-prev-symbol)
(global-set-key "\C-csP" 'cscope-prev-file)
(global-set-key "\C-csu" 'cscope-pop-mark)
;; ---
(global-set-key "\C-csa" 'cscope-set-initial-directory)
(global-set-key "\C-csA" 'cscope-unset-initial-directory)
;; ---
(global-set-key "\C-csL" 'cscope-create-list-of-files-to-index)
(global-set-key "\C-csI" 'cscope-index-files)
(global-set-key "\C-csE" 'cscope-edit-list-of-files-to-index)
(global-set-key "\C-csW" 'cscope-tell-user-about-directory)
(global-set-key "\C-csS" 'cscope-tell-user-about-directory)
(global-set-key "\C-csT" 'cscope-tell-user-about-directory)
(global-set-key "\C-csD" 'cscope-dired-directory)

)
(error "cscope not found"))


;;; Misc

(autoload 'todoo "todoo" "TODO Mode" t)
(add-to-list 'auto-mode-alist '("TODO$" . todoo-mode))

;;; Ruby

(require 'ruby-mode)
(add-to-list 'auto-mode-alist '("\\.rb$" . ruby-mode))

(require 'ruby-electric)

;;; C++

(add-hook 'c++-mode-hook (lambda ()
                           (setq comment-start "/* "
                                 comment-end "*/")))

(add-to-list 'auto-mode-alist '("\\.hrh\\'" . c++-mode))
(add-to-list 'auto-mode-alist '("\\.rss\\'" . c++-mode))

(when xwl-at-company-p
  (add-to-list 'auto-mode-alist '("\\.loc\\'" . c++-mode))
  (add-to-list 'auto-mode-alist '("\\.mmp\\'" . c++-mode))
  (add-to-list 'auto-mode-alist '("\\.inf\\'" . c++-mode)))

;;; sgml, html, xml...

(add-hook 'html-mode-hook
          (lambda ()
            (smart-operator-mode -1)))


;; dvc

;; (require 'dvc-autoloads)

;; (load "~/.emacs.d/site-lisp/nxml/autostart.el")


(defun xwl-join-region (start end)
  "Pack marked region lines into the first line, separated by one blank.
Useful for packing c/c++ functions with one line or empty body."
  (interactive "r")
  (save-restriction
    (narrow-to-region start end)
    (goto-char (point-max))
    (while (not (bobp))
      (join-line))
    (when (search-forward "{" nil t 1)
      (insert " "))
    (when (search-forward "}" nil t 1)
      (backward-char)
      (insert " "))))

(global-set-key (kbd "C-c m j") 'xwl-join-region)

(require 'yaml-mode)
(add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
(add-to-list 'auto-mode-alist '("\\.yaml$" . yaml-mode))

;; (add-hook 'yaml-mode-hook
;;           '(lambda ()
;;              (define-key yaml-mode-map "\C-m" 'newline-and-indent)))

(provide 'xwl-programming)

;;; xwl-programming.el ends here
